home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / obsolete / tiff_dump.pro < prev    next >
Text File  |  1997-07-08  |  6KB  |  225 lines
  1. ; $Id: tiff_dump.pro,v 1.2 1997/01/15 04:02:19 ali Exp $
  2. ;
  3. ; Copyright (c) 1991-1997. Research Systems, Inc. All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5. ;
  6. function tiff_long,a,i,len=len    ;return longword(s) from array a(i)
  7. common tiff_com, order, ifd, count
  8.  
  9. on_error,2              ;Return to caller if an error occurs
  10.  
  11.    if n_elements(len) le 0 then len = 1
  12.    if len gt 1 then result = long(a,i,len) $
  13.    else result = long(a,i)
  14.    if order then byteorder, result, /lswap
  15.    return, result
  16. end
  17.  
  18.  
  19. function tiff_rational,a,i, len = len      ; return rational from array a(i)
  20. common tiff_com, order, ifd, count
  21.  
  22. on_error,2              ;Return to caller if an error occurs
  23.  
  24. if n_elements(len) le 0 then len = 1
  25. tmp = tiff_long(a, i, len = 2 * len)    ;1st, cvt to longwords
  26. if len gt 1 then begin
  27.     subs = lindgen(len)
  28.     rslt = float(tmp[subs*2]) / tmp[subs*2+1]
  29. endif else rslt = float(tmp[0]) / tmp[1]
  30. return, rslt
  31. end
  32.  
  33. function tiff_int,a,i, len=len    ;return unsigned long int from TIFF short int
  34. common tiff_com, order, ifd, count
  35.  
  36. on_error,2              ;Return to caller if an error occurs
  37. if n_elements(len) le 0 then len = 1
  38. if len gt 1 then begin    ;Array?
  39.     result = fix(a,i,len)
  40.     if order then byteorder, result, /sswap
  41.     result = long(result)
  42.     if min(result) lt 0 then begin    ;Convert to unsigned from signed 16bit
  43.       negs = where(result lt 0)
  44.       result[negs] = 65535L + result[negs]
  45.       endif
  46. endif else begin    ;Scalar
  47.     result = fix(a,i)
  48.     if order then byteorder, result, /sswap
  49.     if result lt 0 then result = 65535L + result
  50. endelse
  51. return, result
  52. end
  53.  
  54.  
  55. function tiff_byte, a,i,len=len    ;return bytes from array a(i)
  56. common tiff_com, order, ifd, count
  57.  
  58. on_error,2              ;Return to caller if an error occurs
  59.  
  60.    if n_elements(len) le 0 then len = 1
  61.    if len gt 1 then result = a[i:i+len-1] $
  62.    else result = a[i]
  63.    return, result
  64. end
  65.  
  66.  
  67.  
  68. pro tiff_basic        ;Just load the stuff....
  69. a=1
  70. end
  71.  
  72. pro tiff_dump_field, index, lun    ;Return contents of field index
  73. common tiff_com, order, ifd, count
  74.  
  75. on_error,2                      ;Return to caller if an error occurs
  76. TypeLen = [0, 1, 1, 2, 4, 8] ;lengths of tiff types, 0 is null type for indexin
  77. TypeName = [ 'Undefined', 'Byte', 'Ascii', 'Short', 'Long', 'Rational' ]
  78. TagIndex = [258,320, 301, 259,291,290,257,256,254,262,284,$
  79.     317,296,278,277,279,273,282,283,315,306,316,270,271,272,305,274,255]
  80. TagName = ['BitsPerSample', 'ColorMap', 'ColorResponseCurves','Compression',$
  81.     'GrayResponseCurve','GrayResponseUnit','ImageLength','ImageWidth', $
  82.     'NewSubfileType','PhotometricInterpretation','PlanarConfiguration',$
  83.     'Predictor','ResolutionUnit','RowsPerStrip','SamplesPerPixel',$
  84.     'StripByteCounts','StripOffsets','XResol','Yresol',$
  85.     'Artist','DateTime','HostComputer','ImageDescription','Make','Model',$
  86.     'Software','Orientation','SubfileType' ]
  87.  
  88. ent = ifd[index * 12: index * 12 + 11]  ;Extract the ifd
  89. tag = tiff_int(ent, 0)
  90. typ = tiff_int(ent, 2)
  91. tname = TypeName[typ]
  92. cnt = tiff_long(ent, 4)
  93. if tag ge 32768L then begin        ;Private tag?
  94.   tag = 65536L + tag        ;Unsigned long
  95.   name = '<PrivateTag>'
  96. endif else begin
  97.   i = where(tag eq TagIndex, j)    ;Look up name...
  98.   if j gt 0 then name = TagName[i[0]] else name = '<NoName>'
  99.   if (typ le 0) or (typ gt 5) then $
  100.     message,'Illegal type code, ifd = '+string(index)
  101. endelse
  102.  
  103. print,'*** ',name, ', tag = ', tag, ', ', tname, ', Count = ',cnt
  104.  
  105. nbytes = cnt * TypeLen[typ]
  106. IF (nbytes GT 4) THEN BEGIN     ;value size > 4 bytes ?
  107.         offset = tiff_long(ent, 8)    ;field has offset to value location
  108.         Point_Lun, lun, offset
  109.         val = BytArr(nbytes)     ;buffer will hold value(s)
  110.         Readu, lun, val
  111.         CASE typ OF        ;Ignore bytes, as there is nothing to do
  112.        1: i = 0        ;Dummy
  113.            2: val = String(val)        ;tiff ascii type
  114.            3: val = tiff_int(val,0, len = cnt)
  115.        4: val = tiff_long(val,0, len = cnt)
  116.            5: val = tiff_rational(val,0, len = cnt)
  117.     ENDCASE
  118.     print, val[0: (cnt-1) < 15]
  119. ENDIF ELSE BEGIN            ;Scalar
  120.         CASE typ OF
  121.        1: val = ent[8]
  122.          2: val = string(ent[8:8+(cnt>1)-1])
  123.        3: val = tiff_int(ent,8)
  124.        4: val = tiff_long(ent,8)
  125.         ENDCASE
  126.     print,'  ', val
  127.      ENDELSE
  128. end
  129.  
  130.  
  131. pro tiff_dump, file
  132. ;+
  133. ; NAME:
  134. ;    TIFF_DUMP
  135. ;
  136. ; PURPOSE:
  137. ;    Dump the Image File Directories of a TIFF File.  This procedure is
  138. ;    used mainly for debugging.
  139. ;
  140. ; CATEGORY:
  141. ;    Input/output.
  142. ;
  143. ; CALLING SEQUENCE:
  144. ;    TIFF_DUMP, Filename
  145. ;
  146. ; INPUTS:
  147. ;    Filename:    string containing the name of file to read.
  148. ;        The default extension is ".TIF".
  149. ;
  150. ; OUTPUTS:
  151. ;    All output is to the terminal.  Each TIFF Image File Directory
  152. ;    entry is printed.
  153. ;
  154. ; COMMON BLOCKS:
  155. ;    TIFF_COM.  Only for internal use.
  156. ;
  157. ; SIDE EFFECTS:
  158. ;    A file is read.
  159. ;
  160. ; RESTRICTIONS:
  161. ;    Not all of the tags have names encoded.
  162. ;    In particular, Facsimile, Document Storage and Retrieval,
  163. ;    and most no-longer recommended fields are not encoded.
  164. ;
  165. ; PROCEDURE:
  166. ;    The TIFF file Header and the IFD (Image File Directory) are read
  167. ;    and listed.
  168. ;
  169. ; MODIFICATION HISTORY:
  170. ;    DMS, Apr, 1991.  Extracted from TIFF_READ.
  171. ;    DMS, Dec, 1994.     Added private tags
  172. ;
  173. ;-
  174.  
  175. common tiff_com, order, ifd, count
  176.  
  177. ;on_error,2                      ;Return to caller if an error occurs
  178.  
  179. openr,lun,file, error = i, /GET_LUN, /BLOCK
  180.  
  181. if i lt 0 then begin ;OK?
  182.     if lun gt 0 then free_lun,lun
  183.     lun = -1
  184.     message, 'Error opening ' + file
  185.     endif
  186.  
  187. hdr = bytarr(8)            ;Read the header
  188. readu, lun, hdr
  189.  
  190. typ = string(hdr[0:1])        ;Either MM or II
  191. if (typ ne 'MM') and (typ ne 'II') then begin
  192.     print,'TIFF_READ: File is not a Tiff file: ', file
  193.     return
  194.     endif
  195. order = typ eq 'MM'          ;1 if Motorola 0 if Intel (LSB first or vax)
  196. endian = byte(1,0,2)        ;What endian is this?
  197. endian = endian[0] eq 0        ;1 for big endian, 0 for little
  198. order = order xor endian    ;1 to swap...
  199.  
  200. print,'Tiff File: byte order=',typ, ',  Version = ', tiff_int(hdr,2)
  201.  
  202. offs = tiff_long(hdr, 4)    ;Offset to IFD
  203.  
  204. point_lun, lun, offs        ;Read it
  205.  
  206. a = bytarr(2)            ;Entry count array
  207. readu, lun, a
  208. count = tiff_int(a,0)        ;count of entries
  209. print,count, ' directory entries'
  210. ifd = bytarr(count * 12)    ;Array for IFD's
  211. readu,lun, ifd            ;read it
  212.  
  213. old_tag = 0            ;Prev tag...
  214. for i=0,count-1 do begin    ;Print each directory entry
  215.     tag = tiff_int(ifd, i*12)
  216.     if tag lt old_tag then $
  217.         print,'Error in TIFF file, Directory entries out of order ****'
  218.     old_tag = tag
  219.     tiff_dump_field, i, lun
  220.     endfor    
  221.  
  222. free_lun, lun
  223. lun = -1
  224. end
  225.